Tagging des indicateurs de santé
Philéas Condemine
11 mars 2019
library(data.table)
library(stringi)
library(dplyr)
library(stringr)
library(text2vec)
library(readxl)
library(Matrix)
library(text2vec)
library(rdrop2)
library(ggplot2)
library(plotly)
library(magrittr)
library(stringdist)
library(xgboost)
# GESTION DE LA CONVERSION DES NOMBRES EN CHAINE DE CARACTERES SANS UTILISER LA NOTATION SCIENTIFIQUE
# https://stackoverflow.com/questions/5352099/how-to-disable-scientific-notation
options("scipen"=100, "digits"=10) Préparation des données
Base des indicateurs
Aperçu
data2 <- fread("data/29032018_Index2.csv",encoding="Latin-1")
nb_indicateurs=nrow(data2)Le jeu de données contient indicateurs.
Les données sont principalement textuelles, certaines peut-être plus exploitables que d’autres.
names(data2)## [1] "index"
## [2] "Base"
## [3] "Indicateur"
## [4] "Famille"
## [5] "Famille Finale_DREES"
## [6] "Classement producteur Niveau 3 (le plus détaillé)"
## [7] "Classement producteur Niveau 2"
## [8] "Classement producteur Niveau 1 (le moins détaillé)"
## [9] "thème_DREES"
## [10] "Domaine 1_DREES"
## [11] "Domaine 2_DREES"
## [12] "Domaine 3_DREES"
## [13] "Source"
## [14] "Producteur"
## [15] "Echelle géo. nationale"
## [16] "Echelle géo. Rég"
## [17] "Echelle géo dep"
## [18] "Autre échelle de restitution"
## [19] "Profondeur historique"
## [20] "Fréquence d'actualisation"
## [21] "Commentaires"
## [22] "Base"
## [23] "Date version base"
## [24] "Type d'accès"
## [25] "Accéder à la base"
## [26] "Producteur de la base"
## [27] "index"head(data2,2)#Un View(head(data2,100)) sera peut-être plus approprié pour vous.Variables doublons
La variable index est présente deux fois !
On vérifie que c’est bien les mêmes valeurs les deux fois puis on supprime
data2[c(!data2[,1]==data2[,27]),c(1,27)]data2[,27] <- NULLLa variable Base est présente deux fois !
Même procédure, on observe des différences mais c’est seulement des problèmes de majuscules.
head(data2[c(!data2[,2]==data2[,22]),c(2,22)])data2[c(!tolower(data2[,2])==tolower(data2[,22])),c(2,22)]data2[,22] <- NULLEn particulier certaines méritent peut-être un pré-traitement, par exemple les noms des producteurs INSEE, DREES, CNAMTS écrit en plein texte.
head(sample(data2$Producteur))## [1] "Caisse Nationale de l'Assurance Maladie des Travailleurs Salariés (CNAMTS)"
## [2] "Agence technique de l'information sur l'hospitalisation (ATIH)"
## [3] "Institut national de la statistique et des études économiques (Insee)"
## [4] "Agence régionale de santé (ARS)"
## [5] "Agence technique de l'information sur l'hospitalisation (ATIH)"
## [6] "Direction de la recherche des études de l’évaluation et des statistiques (DREES), Institut national de la statistique et des études économiques (Insee)"Traitement des acronymes avec des expressions régulières
Commençons par une expression régulière pour récupérer le texte entre parenthèses (acronyme)
data2$producteur_acronyme=data2$Producteur%>%
stri_extract_all(regex = "(\\()([A-z]+)(\\))")%>%#On récupère LES chaînes de caractères entre parenthèses
lapply(function(x)paste(x,collapse=" "))%>%# On les colle
unlist%>%gsub(pattern = '(\\()|(\\))',replacement = '') # On met en vecteur et on supprime les parenthèses
data2[producteur_acronyme=="NA",producteur_acronyme:=Producteur]#On gère les noms sans acronyme
table(data2$producteur_acronyme)%>%head##
## Agence de l'eau Air Paca ANMDA
## 153 3 8 1
## ANSM ARS
## 1 254Même idée pour la source
data2$source_acronyme=data2$Source%>%
stri_extract_all(regex = "(\\()([A-z]+)(\\))")%>%#On récupère LES chaînes de caractères entre parenthèses
lapply(function(x)paste(x,collapse=" "))%>%# On les colle
unlist%>%gsub(pattern = '(\\()|(\\))',replacement = '') # On met en vecteur et on supprime les parenthèses
data2[source_acronyme=="NA",source_acronyme:=Source]#On gère les noms sans acronyme
table(data2$source_acronyme)%>%head##
## Accidents de la circulation
## 2283 3
## Adeli Adeli RPPS
## 9 13
## AGATA ALD
## 3 82Suppression des stop-words
Pour remplacer plusieurs mots d’un coup, stringr propose une fonction polymorphe très pratique str_replace_all. Lorsqu’on fournit un vecteur nommé à la place des paramètres pattern et replacement, la fonction est appliquée au vecteur de sorte que pour chaque entrée du vecteur, le nom joue le rôle de pattern et la valeur joue le rôle de replacement.
On commence par construire notre liste de stopwords.
stop_words = tm::stopwords(kind="fr")
# stop_words=c(stop_words,"actifs part entière APE")
stop_words=paste0(" ",stop_words," ")
stop_words=c(stop_words," c'"," l'"," d'"," j'"," t'"," m'"," s'")
fix_stop=rep(" ",length(stop_words))
names(fix_stop) <- stop_wordsPuis on passe en minuscules, on supprime les stopwords puis les espaces en trop.
data2 <- data2%>%
mutate(Indicateur=as.character(Indicateur))%>%#passage en char
mutate_if(is.character,tolower)%>%#en minuscules
mutate_if(is.character,function(x)str_replace_all(x,fix_stop))%>%#suppression de stopwords génériques et spécifiques
mutate_if(is.character,tm::stripWhitespace)#suppression des doubles espacesSuppression des colonnes constantes
cardinality=sapply(data2,function(x)length(unique(x)))
head(cardinality)## index
## 18885
## Base
## 25
## Indicateur
## 18360
## Famille
## 1933
## Famille Finale_DREES
## 1
## Classement producteur Niveau 3 (le plus détaillé)
## 410data2=data2[,cardinality>1]Construction du bloc de texte
data2$Indicateur_enriched=paste(data2$Indicateur,
data2$Famille,
data2$`Classement producteur Niveau 1 (le moins détaillé)`,
data2$`Classement producteur Niveau 2`,
data2$`Classement producteur Niveau 3 (le plus détaillé)`,
data2$source_acronyme,data2$producteur_acronyme)Longueur du texte :
nchar(data2$Indicateur)%>%hist(main="Distribution du nombre de caractères dans le texte")
On va compter les espaces pour se donner une idée du nombre de mots
str_count(data2$Indicateur," ")%>%hist(main="Distribution du nombre de mots dans le texte")
Les tags
Aperçu
Chaque indicateur taggé par machine learning a ensuite été validé par son producteur qui nous a renvoyé un fichier excel, ce qui fait une trentaine de fichiers Excel homogénéisés et empilés. On sautera cette étape et on travaillera directement sur le fichier intermédiaire : tagged_triplet_agreg.RData
load("tagged_triplet_agreg.RData")La fameuse liste des tags.
names(tagged)## [1] "index"
## [2] "Population_generale"
## [3] "Personnes_agees"
## [4] "Enfants__adolescents__jeunes_adultes"
## [5] "Population_precaire"
## [6] "Personnes_handicapees"
## [7] "Sante_des_femmes_perinatalite"
## [8] "Diabete_et_autres_maladies_endocriniennes"
## [9] "Sante_mentale"
## [10] "Cancer"
## [11] "Maladie_de_l_appareil_genito_urinaire"
## [12] "Maladies_cardiovasculaires"
## [13] "Maladies_neurologiques_ou_degeneratives"
## [14] "Maladies_respiratoires"
## [15] "Maladies_de_l_appareil_digestif"
## [16] "Maladies_infectieuses"
## [17] "Pathologies_du_systeme_osteo_articulaire"
## [18] "Traumatismes_et_pathologies_accidentelles"
## [19] "Autres_pathologies"
## [20] "Coordination_continuite"
## [21] "Qualite_et_securite_des_soins"
## [22] "Prevention_depistage"
## [23] "Accessibilite_geographique_financier_autres"
## [24] "Habitudes_de_vie_et_addictions"
## [25] "Determinants_environnementaux"
## [26] "E_sante_systemes_d_information"
## [27] "Droits_d_usagers_democratie_sanitaire"
## [28] "Mesures_d_inegalites_et_de_disparites_territoriales_de_sante"
## [29] "Contexte_demographique_et_socio_economique"
## [30] "Offre_de_soins"
## [31] "Offre_medico_sociale"
## [32] "Recours_aux_soins"
## [33] "Protection_sociale"
## [34] "Depenses_de_sante"
## [35] "Etat_de_sante"
## [36] "Determinants_professionnels"names(tagged) <- tolower(names(tagged))Pour l’instant on dispose d’un tableau avec une ligne par indicateur et pour chaque colonne un ‘top’ tag ie un booléen qui nous indique si le tag est appliqué.
head(tagged[,1:10])Nombre de tags par indicateur
Si on aime le jargon ADD (ACM) on peut parler de tableau disjonctif de la variable ‘tag’ à ceci près que plusieurs modalités sont possibles en même temps…
Justement, combien de tags par indicateur ?
rowSums(tagged%>%select(-index))%>%hist
Matrice sparse
La densité de la matrice de tags vaut 8.2 %.
On préfère le format triplet qui nous servira ensuite pour une représentation en matrice creuse (sparse)
tagged_triplet=reshape::melt(tagged,id.vars="index")
head(tagged_triplet)Machine Learning
Préparation
Echantillonnage train-test
On échantillonne sur les indicateurs et non directement sur les couples indicateurs x tags.
train_smp=sample(tagged_ids,size = round(.75*length(tagged_ids)))
test_smp = setdiff(tagged_ids, train_smp)
train_ind=rowSums(expand.grid((1:length(tags)-1)*nb_indicateurs,train_smp))
test_ind=rowSums(expand.grid((1:length(tags)-1)*nb_indicateurs,test_smp))Bases de train-test
On va sélectionner uniquement les colonnes pertinentes pour l’apprentissage pour ça on a recours à colSums pour vérifier si les colonnes sont constantes égales à 0.
Remarque : Cette pratique nous donne une piste pour l’active learning, on pourra sélectionner les indicateurs les moins bien représentés par le vocabulaire actuellement taggé
ngrams_tagged <- which(colSums(dtm_sp[c(train_ind,test_ind),])>0)
knowns_ind <- tagged_triplet[tagged_triplet$id%in%train_ind,][['i']]
train_ind <- train_ind[train_ind%in%knowns_ind]
train_ind <- sort(train_ind)
train_labels <- tagged_triplet[tagged_triplet$id%in%train_ind,]%>%
arrange(i)%>%.[['value']]
train_dtm <- dtm_sp[train_ind,ngrams_tagged]
dtrain <- xgb.DMatrix(data = as(train_dtm,"dgCMatrix"),
label = train_labels)
## Même chose pour le test qui va aussi nous servir de validation ici parce qu'on ne fait pas de gridsearch.
knowns_ind <- tagged_triplet[tagged_triplet$id%in%test_ind,][['i']]
test_ind <- test_ind[test_ind%in%knowns_ind]
test_ind <- sort(test_ind)
test_labels <- tagged_triplet[tagged_triplet$id%in%test_ind,]%>%
arrange(i)%>%.[['value']]
test_dtm <- dtm_sp[test_ind,ngrams_tagged]
dtest <- xgb.DMatrix(data = as(test_dtm,"dgCMatrix"),
label = test_labels)
watchlist <- list(train = dtrain,eval = dtest)Entraînement
On propose deux stratégies d’apprentissage, la première robuste et lente pour le modèle final, la seconde rapide et “suffisante” pour de l’active learning.
timing="fast"
if (timing=="slow"){
params=list(eta=.1,
max_depth=6,
min_child_weight=5,
subsample=500*length(tags)/length(train_ind),
colsample_bytree=8000/length(ngrams_tagged),
objective="binary:logistic",
eval_metric="auc",
gamma=.01)
nrounds=5E+3
} else if (timing=="fast"){
params=list(eta=.2,
max_depth=8,
min_child_weight=1,
subsample=500*length(tags)/length(train_ind),
colsample_bytree=300/length(ngrams_tagged),
objective="binary:logistic",
eval_metric="auc",
gamma=.01)
nrounds=1E+3
}On lance xgboost
system.time(xgbmodel <- xgb.train(params = params,dtrain,
verbose = 1,print_every_n = 10,
nrounds = nrounds,watchlist,
early_stopping_rounds=200))
save(xgbmodel,file="trained_model.RData")load("trained_model.RData")Analyse des résultats
Importance des variables (ngrams)
Les ngrams précédés de __ sont ceux relatifs aux tags.
Le feature notions est la variable générée à partir du dictionnaire des notions. Elle devrait fonctionner à tous les coups mais on a vu que ce n’est pas toujours le cas.
Gain contribution of each feature to the model. For boosted tree model, each gain of each feature of each tree is taken into account, then average per feature to give a vision of the entire model. Highest percentage means important feature to predict the label used for the training (only available for tree models);
Cover metric of the number of observation related to this feature (only available for tree models);
Weight percentage representing the relative number of times a feature have been taken into trees.
imp=xgb.importance(feature_names = NULL,xgbmodel)
head(imp,100)Ngrams les plus importants par indicateur
get_imp_ngrams=data.table(i=i,j=j)
dico_ngrams=data.frame(j=1:max(j),ngram=dimnm[[2]])
get_imp_ngrams=merge(get_imp_ngrams,dico_ngrams,by="j")
get_imp_ngrams=merge(get_imp_ngrams,imp,by.x="ngram",by.y="Feature")
setorder(get_imp_ngrams,-Gain)
get_imp_ngrams[,order:=1:.N,by="i"]
get_imp_ngrams=get_imp_ngrams[order<=10]
get_imp_ngrams=dcast(get_imp_ngrams,i~order,value.var="ngram")
get_imp_ngrams=merge(get_imp_ngrams,data2[,c("index","Indicateur")],by.x="i",by.y="index")
sample_n(get_imp_ngrams%>%select(-i),10)On remarque que des stopwords nous ont échappé… mais manifestement ils n’étaient pas si “creux” puisque le modèle les a retenu.
Si on voit les choses autrement, on peut se dire que lorsque le ngram influent est un stopwords, les autres ngrams moins influents ne sont probablement pas pertinent. De plus si LE ngram le plus influent est un stopword, alors l’indicateur est probablement mal taggé…